home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / autose1g / declare.bas < prev    next >
Encoding:
BASIC Source File  |  1999-03-23  |  16.8 KB  |  545 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3.  
  4. 'Declare structure types: ships, players, planets
  5.  
  6. Type StarShip
  7.     Troops As Integer
  8.     AssaultTroops As Integer
  9.     '
  10.     HaveShields As Boolean
  11.     
  12.     HaveShield1 As Boolean
  13.     HaveShield2 As Boolean
  14.     
  15.     HaveWeapons As Boolean
  16.     HaveBigShip As Boolean
  17.     HaveCloakingDevice As Boolean
  18.     Hidden As Boolean
  19.     Sabotage As Boolean
  20.     '
  21.     CombatStrength As Integer
  22.     WarpPosition As Integer     '0 if not in use, 1-8 if on warp path
  23.     Coordinate As String        'coord of originating planet
  24.     CenterX As Integer          'used to draw line from starting
  25.     CenterY As Integer          'planet to possible destinations
  26.     Launched As Boolean         'if launched, disable button to launch again
  27.     ShipNumber As Integer       '0 or 1 for array of ship(2) in player structure
  28. End Type
  29.  
  30. Type PlanetaryBody
  31.     Name As String
  32.     Owner As Integer            '0,1,2 for neutral, player 1, player 2
  33.     Troops As Integer
  34.     AssaultTroops As Integer
  35.     '
  36.     HaveShields As Boolean
  37.     HaveMissiles As Boolean     'CS depends on whether player has
  38.                                 'missile1 or 2 researched...
  39.  
  40.     HaveScanner As Boolean
  41.     HaveJammer As Boolean
  42.     InScannerRange As Boolean   'if in range of scanner - replaces sharing of "inrange" with landing
  43.     '
  44.     BioRocketETA As Integer
  45.     BioDistance As Variant
  46.     Contaminated As Boolean     'toxic to humans
  47.     NukedResources As Boolean   'resources wiped out by biorocket
  48.     InBioRange As Boolean       'if in range for biorocket
  49.     LaunchSite As Boolean       'which planet rocket firing from - used
  50.                                 'to erase the lines!
  51.     BioFailed As Boolean        'if enemy tried to use biorocket but it was shot down
  52.     
  53.     '
  54.     CenterX As Integer
  55.     CenterY As Integer
  56.     '
  57.     ImprovedResources As Boolean
  58.     CombatStrength As Integer
  59.     Coordinate As String
  60.     Resources As Integer        'random # resources produced per turn
  61.     InRange As Boolean          'if in range for landing
  62.     BackGround As Integer       '1-5 for landscape picture
  63.     Picture As Integer          '1-5 for galaxy picture - used to restore after contamination
  64.     JustLanded As Boolean       'don't let ship take off after landing on a new planet
  65.     '
  66.     Sabotaged As Boolean            'in frmGameScreen, SabotageLanding, to give other player
  67.     SabotageReduction As Integer    'a message the next turn
  68.     SabotagedFactory As Boolean     'if factory destroyed in sabotage mission
  69.     Damaged As Boolean              'enables cmdRepairIndustry button
  70.                                     'will add 2-4 (up to 8), set to false once resources up to 4
  71.     Captured As Boolean         'for giving a message if other player took over planet on his/her turn
  72.     '
  73.     FailedInvasion As Boolean               'to notify player that opponent tried and failed to attack planet
  74.     FailedInvasionTroopLosses As Integer    'show losses suffered in defense of planet
  75.     FailedInvasionMechLosses As Integer
  76.     '
  77. End Type
  78.  
  79. Type PlayerType
  80.     Name As String
  81.     NumTroops As Integer            'total # of troops
  82.     NumAssaultTroops As Integer
  83.     NumPlanets As Integer           'total # of planets owned
  84.     NumResources As Integer         'total of all resources
  85.     Ship(2) As StarShip
  86.     HomePlanet As Integer           'index number of home planet
  87.     WasBig As Boolean               'announce if empire shrinking
  88.     
  89.     '***Research***
  90.     Missile1ResearchDone As Integer
  91.     Missile1Researched As Boolean
  92.     
  93.     Missile2ResearchDone As Integer
  94.     Missile2Researched As Boolean
  95.  
  96.     ShieldResearchDone As Integer    'time to research planetary shields
  97.     ShieldResearched As Boolean      'whether this tech researched
  98.  
  99.     LaserResearchDone As Integer
  100.     LaserResearched As Boolean
  101.     
  102.     PlasmaResearchDone As Integer
  103.     PlasmaResearched As Boolean
  104.     
  105.     MechResearchDone As Integer     'time to research assault tech
  106.     MechResearched As Boolean       'whether or not player has researched this tech
  107.     
  108.     BioRocketResearchDone As Integer
  109.     BioRocketResearched As Boolean
  110.     
  111.     LongBioResearchDone As Integer
  112.     LongBioResearched As Boolean
  113.     
  114.     ShipShield1ResearchDone As Integer
  115.     ShipShield1Researched As Boolean
  116.     
  117.     ShipShield2ResearchDone As Integer
  118.     ShipShield2Researched As Boolean
  119.     
  120.     BigShipResearchDone As Integer
  121.     BigShipResearched As Boolean
  122.     
  123.     UltraWarpResearchDone As Integer
  124.     UltraWarpResearched As Boolean
  125.     
  126.     CloakingResearchDone As Integer
  127.     CloakingResearched As Boolean
  128.      
  129.     ResourceResearchDone As Integer     'time to research resource improvement
  130.     ResourcesResearched As Boolean      'whether player has researched this tech
  131.     
  132.     BioCleanupResearchDone As Integer
  133.     BioCleanupResearched As Boolean
  134.     
  135.     RegenerationResearchDone As Integer
  136.     RegenerationResearched As Boolean
  137.    
  138.     ScannerResearchDone As Integer
  139.     ScannerResearched As Boolean
  140.     
  141.     DeepScannerResearchDone As Integer
  142.     DeepScannerResearched As Boolean
  143.     
  144.     JammerResearchDone As Integer
  145.     JammerResearched As Boolean
  146.     
  147.     WarpScannerResearchDone As Integer
  148.     WarpScannerResearched As Boolean
  149.     
  150.     '*****
  151.     Message1Given As Boolean        'warning when enemy has 10 planets
  152.     Message2Given As Boolean        'warning when enemy has 20 planets
  153. End Type
  154.  
  155. 'Declare variables of defined types
  156. Public Player(2) As PlayerType
  157. Public Planet(50) As PlanetaryBody
  158.  
  159. 'Declare Global Variables
  160. Public Const Modal = 1              'used to display forms as modal/nonmodal
  161. Public Const NonModal = 0
  162.  
  163. Public gFileNum As Integer          'for reading/writing files
  164. Public TurnNumber As Integer
  165.  
  166. '*****************************
  167. Public Current As Integer           '0 or 1, use to see whose turn it is
  168. Public Other As Integer             '0 or 1
  169. Public Const Neutral = 2            'As Integer    '2 for now...
  170. Public Const Alien = 3              'As Integer    '3 for now
  171. '*****************************
  172. Public ActivePlanet                 'used for buying stuff
  173. Public UnitCost                     '
  174. Public Quantity                     '
  175. Public PurchasePrice                '
  176. '*****************************
  177. Public IncomingMessage As String    'for the messages players
  178. Public OutgoingMessage As String    'send to each other
  179.  
  180. Public activeship As Integer        'either 0 or 1 for ship number
  181.  
  182. '************
  183. 'Combat:
  184. Public AttackStrength As Integer
  185. Public DefenceStrength As Integer
  186. Public Losses As Integer
  187. Public TroopLosses As Integer
  188. Public AssaultLosses As Integer
  189.  
  190. Public NumPlanetsCaptured As Integer    'counter to see how many planets of other player taken over this turn
  191.  
  192. Public NumFailedInvasions As Integer    'counter for failed invasions by other player
  193. '************
  194.  
  195. Public TechLevel As Integer         'for setting up techdone form
  196.                                     'sets which title, image and description to show
  197.                              
  198. Public ReadyToLand1 As Boolean      'toggle for land1 button
  199. Public ReadyToLand2 As Boolean
  200.  
  201. Public ScannerOn As Boolean         'toggle for mousemove, how much info shown
  202.                                     'in txtstatus.text for planets
  203.                                     
  204. Public BioRocketOn As Boolean       'toggle for biorocket launch button
  205. Public RegenerateOn As Boolean      'toggle
  206. Public DetoxifyOn As Boolean        'toggle
  207.  
  208. 'Sound API
  209. Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  210. Public Sound As String
  211. Public SoundOn As Boolean           'for sound toggle
  212.  
  213. '************************
  214. Public GalaxySize As Integer        'for different number of planets E/M/H
  215. '************************
  216. Public MessageType As String        'to set picture and text for Message Form
  217.                                     'ie. biorocket explosion, planet overrun
  218. Public Announceline1 As String      'to set text for beeping text announcement
  219. Public Announceline2 As String
  220. Public Announceline3 As String
  221.  
  222. Public LoadCancelled As Boolean     'if player aborts loading a game
  223.                                     'this goes back to frmcover
  224.                                   
  225. Public GameNumber As Integer        'to set the proper default game number when saving
  226.                                     'so people don't save the wrong game # by mistake
  227.             
  228. Public GameName As String           'to show the user after compressing
  229.  
  230. 'to disable the X button on the control box
  231. Public Declare Function GetSystemMenu Lib "User32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
  232. Public Declare Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long
  233. Public Declare Function RemoveMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  234. Public Declare Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long
  235.  
  236. Public Const MF_BYPOSITION = &H400&
  237. Public Const MF_DISABLED = &H2&
  238. '**************************************
  239.  
  240. 'NOT IMPLEMENTED - To check if Install.log exists - if not, have to register zlibtool.ocx
  241. Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  242. Public sysDir As String
  243.  
  244. '***NEW for March 99***config file
  245. Public DefaultGameSize As Integer       'to set size of playing screen: 0 is normal, 2 is maximized
  246. Public DefaultGameSound As Boolean      'set default sound setting (on/off)
  247.  
  248.  
  249. Sub main()
  250.  
  251. Randomize
  252.  
  253. 'I added a zlib dll control to frmCover, to check for registration errors right
  254. 'at the start - if it can't load frmCover, that's because of the zlib control
  255. 'on the form.  As noted elsewhere, for some reason the install program is not
  256. 'registering the custom control zlibOCX2.dll, which compresses the saved game info.
  257.  
  258. 'If there's an error, the user gets a messagebox explaining that
  259. 'they have to run the program 'regfile', which is included in the install package.
  260. 'The regfile program checks to make sure the user has regsvr32.exe and zlibOCX2.dll in the
  261. 'windows\system directory - if not, another messagebox tells them this.
  262. 'Alternatively, the user could run regsvr32 manually - that's still covered
  263. 'in the readme file...
  264.  
  265.  
  266. On Error GoTo ZipError
  267.  
  268. frmCover.Show
  269. On Error GoTo 0
  270.  
  271. Exit Sub
  272.  
  273.  
  274. ZipError:
  275.     Dim ErrorMessage As String
  276.     ErrorMessage = "The install program did not properly register a required file." + Chr(13)
  277.     ErrorMessage = ErrorMessage + "Please run 'regfile.exe', located in the game directory." + Chr(13) + Chr(13)
  278.     ErrorMessage = ErrorMessage + "If you're still having trouble, please refer to the" + Chr(13)
  279.     ErrorMessage = ErrorMessage + "Troubleshooting section of the Readme file."
  280.     
  281.     MsgBox ErrorMessage, vbOKOnly + vbInformation, "A Slight Installation Problem..."
  282.     End
  283.  
  284. End Sub
  285.  
  286.  
  287.  
  288. Public Sub SetCombatStrength(i As Integer)
  289. 'run after: launch, buy troops/assault troops, buy shields/missiles, battles
  290. Dim X, Y
  291.  
  292. Planet(i).CombatStrength = 0
  293. X = Planet(i).Troops
  294. Y = Planet(i).AssaultTroops
  295.  
  296. 'laser and plasma for troops?
  297. If Player(Current).LaserResearched Then
  298.     X = Int(X * 1.15)
  299. End If
  300.  
  301. If Player(Current).PlasmaResearched Then
  302.     X = Int(X * 1.3)
  303. End If
  304.  
  305. '****Main Formula:
  306. Planet(i).CombatStrength = X + (Y * 5)
  307. '****
  308.  
  309. If Planet(i).HaveMissiles Then
  310.     If Player(Current).Missile1Researched Then
  311.         Planet(i).CombatStrength = Planet(i).CombatStrength + 5
  312.     End If
  313.  
  314.     If Player(Current).Missile2Researched Then
  315.         Planet(i).CombatStrength = Planet(i).CombatStrength + 7
  316.     End If
  317. End If
  318.  
  319. If Planet(i).HaveShields Then
  320.     'add 25 to CS
  321.     Planet(i).CombatStrength = Planet(i).CombatStrength + 25
  322. End If
  323.  
  324. End Sub
  325.  
  326. Public Sub playBeep()
  327. On Error Resume Next
  328. If SoundOn Then
  329.     Sound = App.Path + "\Button1.wav"
  330.     sndPlaySound Sound, 3
  331.     On Error GoTo 0
  332. End If
  333.  
  334. End Sub
  335.  
  336.  
  337. Public Sub PlaySoundEffect(Sound As String)
  338. 'play soundeffects as called throughout program
  339. 'uses the sndPlaySound API, declared in Declarations section of this module
  340.  
  341. On Error GoTo ErrHandler
  342.  
  343. If SoundOn And Sound <> "" Then
  344.  
  345.     Select Case Sound
  346.         Case "Abort"
  347.             Sound = App.Path + "\badnews.wav"
  348.             sndPlaySound Sound, 0
  349.  
  350.         Case "Access"
  351.             Sound = App.Path + "\access.wav"
  352.             sndPlaySound Sound, 3
  353.   
  354.         Case "Ambient1"
  355.             Sound = App.Path + "\ambient1.wav"
  356.             sndPlaySound Sound, 3
  357.     
  358.         Case "Ambient3"
  359.             Sound = App.Path + "\ambient3.wav"
  360.             sndPlaySound Sound, 3
  361.  
  362.         Case "Attack"
  363.             Sound = App.Path + "\attack.wav"
  364.             sndPlaySound Sound, 3
  365.  
  366.         Case "BioFail"
  367.             Sound = App.Path + "\biofail.wav"
  368.             sndPlaySound Sound, 3
  369.  
  370.         Case "Button1"
  371.             Sound = App.Path + "\button1.wav"
  372.             sndPlaySound Sound, 3
  373.  
  374.         Case "Button2"
  375.             Sound = App.Path + "\button2.wav"
  376.             sndPlaySound Sound, 3
  377.  
  378.         Case "Button3"
  379.             Sound = App.Path + "\button3.wav"
  380.             sndPlaySound Sound, 3
  381.  
  382.         Case "Button4"
  383.             Sound = App.Path + "\button4.wav"
  384.             sndPlaySound Sound, 3
  385.  
  386.         Case "Button5"
  387.             Sound = App.Path + "\button5.wav"
  388.             sndPlaySound Sound, 3
  389.  
  390.         Case "Detonate"
  391.             Sound = App.Path + "\detonate.wav"
  392.             sndPlaySound Sound, 3
  393.  
  394.         Case "Disintegrate"
  395.             Sound = App.Path + "\disintegrate.wav"
  396.             sndPlaySound Sound, 3
  397.  
  398.         Case "Explosion"
  399.             Sound = App.Path + "\explode.wav"
  400.             sndPlaySound Sound, 3
  401.  
  402.         Case "Intro"
  403.             Sound = App.Path + "\intro.wav"
  404.             sndPlaySound Sound, 3
  405.  
  406.         Case "Launch"
  407.             Sound = App.Path + "\launch3.wav"
  408.             sndPlaySound Sound, 3
  409.     
  410.         Case "Overrun"
  411.             Sound = App.Path + "\overrun.wav"
  412.             sndPlaySound Sound, 3
  413.  
  414.         Case "Quiet"
  415.             Sound = App.Path + "\quiet.wav"
  416.             sndPlaySound Sound, 3
  417.     
  418.         Case "Research"
  419.             Sound = App.Path + "\research.wav"
  420.             sndPlaySound Sound, 3
  421.  
  422.         Case "Sabotage"
  423.             Sound = App.Path + "\sabotage.wav"
  424.             sndPlaySound Sound, 3
  425.     
  426.         Case "Warning"
  427.             Sound = App.Path + "\warning.wav"
  428.             sndPlaySound Sound, 3
  429.  
  430.     End Select
  431.  
  432. Else
  433.     'sound is off, so don't let Windows use default button sounds
  434.     Sound = App.Path + "\quiet.wav"
  435.     sndPlaySound Sound, 3
  436.     
  437. End If
  438.  
  439.  
  440. Exit Sub
  441.  
  442.  
  443. ErrHandler:
  444.     'error playing sound
  445.     Exit Sub
  446.     
  447.  
  448. End Sub
  449.  
  450. Public Sub PlayRandomSound()
  451. 'plays a random sound effect every 30 seconds
  452. 'activated by tmrRandomSounds in frmGameScreen
  453.  
  454. On Error GoTo SoundError
  455.  
  456. If SoundOn Then
  457.   Randomize
  458.   Dim X As Integer
  459.  
  460.   X = Int(Rnd * 6) + 1
  461.  
  462.   Select Case X
  463.   Case 1
  464.     Sound = App.Path + "\short1.wav"
  465.     sndPlaySound Sound, 3
  466.   Case 2
  467.     Sound = App.Path + "\short2.wav"
  468.     sndPlaySound Sound, 3
  469.   Case 3
  470.     Sound = App.Path + "\short3.wav"
  471.     sndPlaySound Sound, 3
  472.   Case 4
  473.     Sound = App.Path + "\short4.wav"
  474.     sndPlaySound Sound, 3
  475.   Case 5
  476.     Sound = App.Path + "\short5.wav"
  477.     sndPlaySound Sound, 3
  478.   Case 6
  479.     Sound = App.Path + "\short6.wav"
  480.     sndPlaySound Sound, 3
  481.   End Select
  482. Else
  483.     Exit Sub
  484. End If
  485.  
  486. Exit Sub
  487.  
  488.  
  489. SoundError:
  490.     'sound problem - exit sub
  491.     Exit Sub
  492.  
  493. End Sub
  494.  
  495. Public Sub ShowQuickHelp()
  496. 'show quick help when user hits escape key
  497.         
  498. Dim message As String
  499.  
  500. message = "Function Key Commands:" & Chr(13) & Chr(13)
  501. message = message + "Esc   This Quick Help Screen" + Chr(13)
  502. message = message + "F1     4000 A.D. Help File" + Chr(13)
  503. message = message + "F2     Save Game" + Chr(13)
  504. message = message + "F3     Abort Game" + Chr(13)
  505. message = message + "F4     Toggle Grid Lines On/Off" + Chr(13)
  506. message = message + "F5     Toggle Sound On/Off" + Chr(13)
  507. message = message + "F6     Configure Game Options" + Chr(13)
  508.         
  509. MsgBox message, vbOKOnly, "4000 A.D. Quick Help"
  510.  
  511.  
  512. End Sub
  513.  
  514. Public Sub DisableX(Frm As Form)
  515.     
  516. Dim hMenu As Long, nCount As Long
  517.     
  518. 'Get handle to system menu
  519. hMenu = GetSystemMenu(Frm.hWnd, 0)
  520.  
  521. 'Get number of items in menu
  522. nCount = GetMenuItemCount(hMenu)
  523.     
  524. 'Remove last item from system menu (last item is 'Close')
  525. Call RemoveMenu(hMenu, nCount - 1, MF_DISABLED Or MF_BYPOSITION)
  526.  
  527. 'Redraw menu
  528. DrawMenuBar Frm.hWnd
  529.  
  530.  
  531. End Sub
  532.  
  533. Public Function FileExists%(FullPathAndFile$)
  534. 'NOT IMPLEMENTED
  535. 'used to see if Install.log exists, showing that the
  536. 'zlibtool.ocx has been registered
  537.  
  538. On Error Resume Next
  539.  
  540. If FileLen(FullPathAndFile) > 0& Then
  541.      If Err = 0 Then FileExists = True
  542. End If
  543.  
  544. End Function
  545.